open Graph

module Cover (G: Sig.G)
= struct
	
	let (|>) x y = y x
	
	module N = Oper.Neighbourhood(G)
	open N.Vertex_Set
	open Utils
	module U = Utils(G)

(*greedy algorithm*)
(*start is needed to determine vertecies that must be included in cover*)
	let greedyCover graph allVertecies start =
		let rec insert elem = function
				| x::xs when (G.out_degree graph x) > (G.out_degree graph elem) ->
						x :: insert elem xs
				| xs ->	elem :: xs
		in
		let rec sortedNodeList vertecies list =
			List.fold_left (fun list x -> insert x list) list vertecies
		in		
		let sortedVertecies = sortedNodeList allVertecies []
		in
		let	rec findCover vertecies cover = 
			if (U.isCover cover graph)
			then cover
			else (List.hd vertecies) :: cover |> findCover (List.tl vertecies)
		in
		findCover sortedVertecies start

	(*gybrid genetic algorithm *)
	let geneticAlgorithm graph numberOfPopulations = 
		(*all vertecies of graph in set*)
		let graphVerticies = U.allVertecies graph
		in
		(*every list is graph without one verties - it is vertex cover too*)
		let firstPopulation graph =
			let rec someCover oldOne newOne population = 
				match newOne with
					| x::xs -> (List.append oldOne xs)::population |> someCover (List.append oldOne [x]) xs
					| [] -> population
			in
			someCover [] (N.Vertex_Set.elements graphVerticies) []
		in		
		(*give us one new cover from two old ones*)
		let crossover parent1 parent2 =		
      (*addition into table of vertecies*)
			let rec addIntoTable elem freq = function
					| x::xs when (((G.out_degree graph x)>(G.out_degree graph elem)) ||
													(((G.out_degree graph x)=(G.out_degree graph elem)) && (freq=1)))
											-> x::addIntoTable elem freq xs
					| xs -> elem::xs
			in			
			(*bilding table of vertecies by using two covers*)
			let rec tableFreq p1 p2 table = 
				match (p1,p2) with
					| ([],[]) -> table
					| ([],x::xs) -> addIntoTable x 1 table |> tableFreq [] xs 
					| (x::xs,[]) -> addIntoTable x 1 table |> tableFreq xs [] 
					| (x::xs,a) -> 					
            (*if we will find x in a - we must remove it and add into table with freq = 2
              otherwise with freq = 1*)
						let rec findAndRem table elem newList = function
								| x::xs when x = elem -> (List.append newList xs, addIntoTable x 2 table)
								| x::xs -> findAndRem table elem (x::newList) xs
								| [] -> (newList, addIntoTable x 1 table)
						in
						let (list, newTable) = findAndRem table x [] a
						in
						tableFreq xs list newTable
			in
			(*we will take per one vertex from table until there will not any free edges in 
        graph*)
			let rec child table son vertecies = 
				if N.Vertex_Set.elements vertecies |> U.isThereNoEdge graph
				then
					son
				else 
					remove (List.hd table) vertecies |> child (List.tl table) (List.hd table :: son)
			in
			child (tableFreq parent1 parent2 []) [] graphVerticies
		in
		let mutationSimple cover =
      (*get random elem from list*)	
      let getRandomElem list = 
        (* actualy, we can use such randomise as*)
				(* random = List.length list |> Random.int*)
        (* and we will have always the same result*)
        (* But it will allow to get better results sometimes*)
        let random = (Sys.time() *. 10000. |> Int32.of_float |> Int32.to_int |> Random.int) mod (List.length list)
        in
        List.nth list random
      in
      let randomVertex = U.removeAll graphVerticies cover |> getRandomElem
      in
      let rec mut proposition vertecies = 
      	if (U.isCover proposition graph)
          then proposition
          else
            (* also we can use here*)
            (*let vertex = max_elt vertecies*)
            (* and*)
            (* vertex = choose vertecies*)
            (* In many cases it will work better*)
            (*let vertex = N.Vertex_Set.elements vertecies |> getRandomElem
            in
            remove vertex vertecies |> mut (vertex::proposition)*)
						(*But as me use greedy algorithm everywhere, so*)
					greedyCover graph vertecies proposition
      in
      remove randomVertex graphVerticies |> N.Vertex_Set.elements |> mut [randomVertex]
		in 
		(* return new population by giving old one*)
		let population old = 
			(*it's children of old population*)
			let rec partPopulation oldOne newOne = 
				(*the rule of addition in sorted list of covers*)
				let rec addIntoList elem = function
						| [] -> [elem]
						| x::xs when List.length x < List.length elem -> x :: addIntoList elem xs
						| xs -> elem::xs
				in
				match oldOne with
					| (x::xx::xs) -> addIntoList (crossover x xx |> mutationSimple) newOne |> partPopulation xs 
					| [x] -> addIntoList (mutationSimple x) newOne
					| [] -> newOne
			in
			List.merge (fun l1 l2 -> if (List.length l1)<(List.length l2) then -1 else 1) 
								 (U.halfOfList old)
								 (partPopulation old [])
		in
		(*allow us get the exact number of populations*)
		let newPop number oldPop = 
			let rec usefullPop num old usefull = 
				if (num = number) then (old,usefull) 
					else 
						let oldSize = List.hd old |> List.length
						in
						let pop = population old
						in 
						usefullPop (num+1) pop (if (oldSize > (List.hd pop |> List.length))
																			then num + 1
																			else usefull)
			in
			usefullPop 1 oldPop 1
		in
		let listOfPop, usefullNum = firstPopulation graph |> newPop numberOfPopulations
		in
		(List.hd listOfPop, usefullNum)
end